home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / PROLOG / HUMBOLT / HUMBOLTS / _files / _humboltsr / TYPES._h < prev    next >
Text File  |  1990-12-08  |  15KB  |  548 lines
  1. /***************************************************
  2. ****************************************************
  3. **                                                **
  4. **  HU-Prolog     Portable Interpreter System     ** 
  5. **                                                **
  6. **  Release 1.62   January  1990                  **
  7. **                                                **
  8. **  Authors:      C.Horn, M.Dziadzka, M.Horn      **
  9. **                                                **
  10. **  (C) 1989      Humboldt-University             **
  11. **                Department of Mathematics       **
  12. **                GDR 1086 Berlin, P.O.Box 1297   **
  13. **                                                **
  14. ****************************************************
  15. ***************************************************/
  16.  
  17.  
  18. #define IMPORT  extern
  19. #define FORWARD extern
  20. #define LOCAL   static
  21. #define GLOBAL
  22.  
  23. #if P8000 || SUN3 || VMS
  24. #define REGISTER  register /*if the system has up to 6 registers */
  25. #endif
  26.  
  27. #if !(P8000 || SUN3 || VMS )
  28. #define REGISTER  /* no register */
  29. #endif
  30.  
  31. #if BIT16 || BIT8
  32. #define maxint (32767)            /* maximal integer */
  33. #define minint (-32767)           /* minimal integer */
  34. #endif
  35.  
  36. #if BIT32
  37. #define maxint (2147483647)
  38. #define minint (-2147483647)
  39. #endif
  40.  
  41. #if LONGARITH
  42. #define maxlong (2147483647l)
  43. #define minlong (-2147483647l)
  44. #endif
  45.  
  46. typedef unsigned int card;
  47. #if !CPM /* byte is a standard type of Manx C */
  48. typedef unsigned char byte;
  49. #endif
  50.  
  51. typedef char *string;  /* real strings, virtual strings are STRING  */
  52.  
  53. IMPORT string itoa();
  54.  
  55. #if !MSC 
  56. #define far /* special keyword of Microsoft C-Compilers */
  57. #endif
  58.  
  59. #define MAXPREC 2047     /* Max. operator precedence. */
  60. #define SUBPREC  999     /* Max. prec. for subterms. */
  61.  
  62. #define boolean  card
  63. #define bit      card 
  64.  
  65. #define true     1
  66. #define false    0
  67.  
  68. /********************************************************************/
  69. /* References to data structures are implemented as integers,
  70.    giving the entry number for a virtual address space. The 
  71.    reference to the dynamic data structures itself is realized
  72.    by an access function.
  73. */
  74. /********************************************************************/
  75.  
  76. #if !POINTEROFFSET
  77. #define TERM     card
  78. #define ATOM     card
  79. #define CLAUSE   TERM
  80. #define TRAIL    card
  81. #define ENV      card
  82. #define STRING   card
  83. #define nil_clause         (TERM)0
  84. #define non_nil_clause(c)  (c)
  85. #define nil_term           (TERM)0
  86. #define non_nil_term(t)    (t)
  87. #define nil_atom           (ATOM)0
  88. #define non_nil_atom(a)    (a)
  89. #define nil_env            (ENV)0
  90. #define non_nil_env(e)     (e)
  91. #endif
  92.  
  93. #if POINTEROFFSET
  94. #define ATOM     int
  95. #define ENV      card
  96. #define STRING   int
  97.  
  98. typedef struct TERM_NODE 
  99.   { ATOM tNAME; 
  100.     union { struct TERM_NODE *t_son;
  101.             int t_ival;
  102.             struct TERM_NODE *t_val;
  103.             int t_offset;
  104.           } tNODECASE; } TERMNODE,*TERM;
  105. typedef TERM *TRAIL;
  106. typedef TERM CLAUSE;
  107.  
  108. #define nil_clause         (&TERMAREA[0]) 
  109. #define non_nil_clause(C)  ((C) != nil_clause)
  110. #define nil_term           (&TERMAREA[0])
  111. #define non_nil_term(C)    ((C) != nil_term)
  112. #define nil_atom           (ATOM)0
  113. #define non_nil_atom(C)    ((C) != nil_atom)
  114. #define nil_env            (ENV)0
  115. #define non_nil_env(e)     (e)
  116. #endif
  117.  
  118. /****************************************************************/
  119. /*   global programmodes                                         */
  120. /****************************************************************/
  121.  
  122. #define SYSM 0
  123. #define PROGM 1
  124. #define USERM 2
  125. #define PHASE card
  126.  
  127. /***************************************************************/
  128. /*  access definition                                   */
  129. /***************************************************************/
  130.  
  131. #if BIC 
  132. #define acc(t,f,i)        (*f(i))
  133. #define faracc(t,f,i)     (*f(i))
  134. #define inc_trail(i)      (++i)
  135. #define inc_env(i)        (++i)
  136. #define inc_atom(i)       (++i)
  137. #define inc_term(i)       (++i)
  138. #define dec_trail(i)      (--i)
  139. #define dec_atom(i)       (--i)
  140. #define dec_term(i)       (--i)
  141. #define trail_units(i)    i
  142. #define env_units(i)      i
  143. #define atom_units(i)     i
  144. #define term_units(i)     i
  145. #define exrnal(t,f)     extern t *f()
  146. #define farexternal(t,f)  extern t *f()
  147. #define declare(t,f,i)    t *f(n) int n; { static t f[i]; return &(f[n]); } 
  148. #define fardeclare(t,f,i) t *f(n) int n; { static t f[i]; return &(f[n]); } 
  149. #endif
  150.  
  151.  
  152. #if BYTEOFFSET
  153. #define acc(t,f,i)        (*((t *)(&(f[i]))))
  154. #define faracc(t,f,i)     (*((t far *)(&(f[i]))))
  155. #if BIT8 || BIT16
  156. #define inc_trail(i)      (i+=2)
  157. #define inc_env(i)        (i+=2)
  158. #define inc_atom(i)       (i+=2)
  159. #define inc_term(i)       (i+=2)
  160. #define dec_trail(i)      (i-=2)
  161. #define dec_atom(i)       (i-=2)
  162. #define dec_term(i)       (i-=2)
  163. #define trail_units(i)    (2*(i))
  164. #define env_units(i)      (2*(i))
  165. #define atom_units(i)     (2*(i))
  166. #define term_units(i)     (2*(i))
  167. #endif
  168. #if BIT32
  169. #define inc_trail(i)      (i+=4)
  170. #define inc_env(i)        (i+=4)
  171. #define inc_atom(i)       (i+=4)
  172. #define inc_term(i)       (i+=4)
  173. #define dec_trail(i)      (i-=4)
  174. #define dec_atom(i)       (i-=4)
  175. #define dec_term(i)       (i-=4)
  176. #define trail_units(i)    (4*(i))
  177. #define env_units(i)      (4*(i))
  178. #define atom_units(i)     (4*(i))
  179. #define term_units(i)     (4*(i))
  180. #endif
  181. #define external(t,f)     extern char f[]
  182. #define farexternal(t,f)  extern char far f[]
  183. #define declare(t,f,i)    char f[i*sizeof(t)]
  184. #define fardeclare(t,f,i) char far f[i*sizeof(t)]
  185. #endif
  186.  
  187. #if WORDOFFSET
  188. #define acc(t,f,i)        f[i]
  189. #define faracc(t,f,i)     f[i]
  190. #define inc_trail(i)      (++i)
  191. #define inc_env(i)        (++i)
  192. #define inc_atom(i)       (++i)
  193. #define inc_term(i)       (++i)
  194. #define dec_trail(i)      (--i)
  195. #define dec_atom(i)       (--i)
  196. #define dec_term(i)       (--i)
  197. #define trail_units(i)    (i)
  198. #define env_units(i)      (i)
  199. #define atom_units(i)     (i)
  200. #define term_units(i)     (i)
  201. #define external(t,f)     extern t f[]
  202. #define farexternal(t,f)  extern t far f[]
  203. #define declare(t,f,i)    t f[(i)]
  204. #define fardeclare(t,f,i) t far f[(i)]
  205. #endif
  206.  
  207. #if POINTEROFFSET
  208. #define acc(t,f,i)        f[i]
  209. #define faracc(t,f,i)     f[i]
  210. #define inc_trail(i)      (++i)
  211. #define inc_env(i)        (++i)
  212. #define inc_atom(i)       (++i)
  213. #define inc_term(i)       (++i)
  214. #define dec_trail(i)      (--i)
  215. #define dec_atom(i)       (--i)
  216. #define dec_term(i)       (--i)
  217. #define trail_units(i)    (i)
  218. #define env_units(i)      (i)
  219. #define atom_units(i)     (i)
  220. #define term_units(i)     (i)
  221. #define external(t,f)     extern t f[]
  222. #define farexternal(t,f)  extern t f[]
  223. #define declare(t,f,i)    t f[i]
  224. #define fardeclare(t,f,i) t f[i]
  225. #endif
  226.  
  227.  
  228. /***************************************************************/
  229. /*  definition for terms and clauses                           */
  230. /***************************************************************/
  231.  
  232.  
  233. #if !POINTEROFFSET
  234. farexternal(ATOM,tNAME);
  235. farexternal(card,tNODECASE);
  236.  
  237. #define name(term)       faracc(ATOM,tNAME,term)
  238. #define son(term)        faracc(TERM,tNODECASE,term)
  239. #define ival(term)       son(term) 
  240. #define val(term)        son(term) 
  241. #define offset(term)     son(term) 
  242.  
  243. #define br(term)         ((term)+term_units(1))
  244. #define next_br(T)       ((T) +=term_units(1)) /* see also arg3 */
  245. #endif
  246.  
  247. #if POINTEROFFSET
  248. #ifdef DYNMEM
  249. extern TERMNODE *TERMAREA;
  250. #else
  251. extern TERMNODE TERMAREA[];
  252. #endif
  253.  
  254. #define name(term)       ((term)->tNAME)
  255. #define son(term)        /*(TERM)*/((term)->tNODECASE.t_son)
  256. #define ival(term)       /*(int)*/((term)->tNODECASE.t_ival)
  257. #define val(term)        /*(TERM)*/((term)->tNODECASE.t_val)   
  258. #define offset(term)     /*(int)*/((term)->tNODECASE.t_offset)
  259.  
  260. #define br(term)         ((term)+1)
  261. #define next_br(T)       (++(T)) 
  262. #endif
  263.  
  264.  
  265. IMPORT TERM stackterms(),heapterms();
  266. IMPORT TERM mkfunc(),mkatom(),mkint(),mkfreevar(),mk2sons();
  267. IMPORT TERM arg1(),arg2(),arg3(),arg4();
  268.  
  269. /*  definition for clauses */
  270.  
  271. #define nextcl(clause)   son(clause) 
  272.  
  273. #define head(clause)     br(br(clause))
  274. #define body(clause)     br(br(br(clause)))
  275. #define setnvars(clause,N)      (ival(br(clause))=(int)term_units(N)) 
  276. #define var_sizes(clause)       ((int)ival(br(clause))) 
  277.  
  278. #define deny(clause)     setnvars(clause,0x7fff) 
  279. #define denied(clause)   (var_sizes(clause)== 0x7fff) 
  280.  
  281. #define DUMMYCL  (CLAUSE)(0xffff) 
  282.  
  283. /**************************************************************/
  284. /*
  285.  *  atoms
  286.  */
  287. /**************************************************************/
  288.  
  289. #define NONO 0
  290. #define FXO 1
  291. #define FYO 2
  292. #define XFO 3
  293. #define YFO 4
  294. #define XFXO 5
  295. #define XFYO 6
  296. #define YFXO 7
  297.  
  298. #define NORMP       0
  299. #define EVALP       1
  300. #define BTEVALP     2
  301. #define VARP        3
  302. #define CUTP        4
  303. #define ANDP        5
  304. #define ORP         6
  305. #define ARITHP      7
  306. #define CCONSP      8
  307. #define FAILP       9
  308. #define ISVARP     10
  309. #define ISATOMP    11
  310. #define ISINTEGERP 12
  311. #define GOTOP      13
  312. #define ISMEMBP    14
  313. #define NOMEMBP    15
  314.  
  315. #define  PREC   unsigned
  316.  
  317. #define MAXARITY 127     /* max. arity for atoms */
  318. #define ARITY_TYPE unsigned char  
  319. #define PREC_TYPE unsigned short  
  320. #define INFO_TYPE unsigned short  
  321.  
  322. #ifdef DYNMEM
  323. extern ARITY_TYPE *a_ARITY; 
  324. extern CLAUSE *a_CLAUSE;
  325. extern STRING *a_IDENT;
  326. extern ATOM *a_NEXTATOM;
  327. extern ATOM *a_CHAINATOM;
  328. extern PREC_TYPE *a_PREC;
  329. extern INFO_TYPE *a_INFO;
  330. #if HACKY
  331. extern card *a_NROFCALLS;
  332. #endif
  333.  
  334. #else
  335. external(ARITY_TYPE,a_ARITY); 
  336. external(CLAUSE,a_CLAUSE);
  337. farexternal(STRING,a_IDENT);
  338. farexternal(ATOM,a_NEXTATOM);
  339. farexternal(ATOM,a_CHAINATOM);
  340. farexternal(PREC_TYPE,a_PREC);
  341. farexternal(INFO_TYPE,a_INFO);
  342. #if HACKY
  343. farexternal(card,a_NROFCALLS);
  344. #endif
  345.  
  346. #endif
  347.  
  348. #if BIT8
  349. #define repchar(c)               acc(char,STRINGTAB,c)
  350. external(char,STRINGTAB);
  351. extern string tempcopy();
  352. #endif
  353. #if ! BIT8  
  354. #define repchar(c)               STRINGTAB[c]
  355.  
  356. #ifdef DYNMEM
  357. extern char *STRINGTAB;
  358. #else
  359. extern char STRINGTAB[];
  360. #endif
  361.  
  362. #if POINTEROFFSET
  363. #define tempcopy(a)              (&(STRINGTAB[longstring(a)]))
  364. #endif
  365. #endif
  366.  
  367. #define arity(atom)              (acc(ARITY_TYPE,a_ARITY,atom))
  368. #define clause(atom)             (acc(CLAUSE,a_CLAUSE,atom))
  369. #define longstring(atom)         (faracc(STRING,a_IDENT,atom))
  370. #define nextatom(atom)           (faracc(ATOM,a_NEXTATOM,atom))
  371. #define chainatom(atom)          (faracc(ATOM,a_CHAINATOM,atom))
  372. #define oprec(atom)              (faracc(PREC_TYPE,a_PREC,atom))
  373. #define info(atom)               (faracc(INFO_TYPE,a_INFO,atom))
  374. #if HACKY
  375. #define nrofcalls(atom)          (faracc(card,a_NROFCALLS,atom))
  376. #endif
  377.  
  378. #define class(atom)              (info(atom) & 0x000f)
  379. #define setclass(atom,n)         (info(atom)=(info(atom)&0xfff0) | n)
  380.  
  381. #define oclass(atom)             ((info(atom) & 0x00f0) >> 4)
  382. #define setoclass(atom,n)        (info(atom)=(info(atom)&0xff0f)|(n<<4))
  383.  
  384. #define private(atom)            (info(atom) & 0x0800)
  385. #define setprivate(atom)         (info(atom) |=0x0800)
  386. #define setnotprivate(atom)      (info(atom) &=0xf7ff)
  387.  
  388. #define system(atom)             (info(atom) & 0x0400)
  389. #define setsystem(atom)          (info(atom) |=0x0400)
  390. #define setnotsystem(atom)       (info(atom) &=0xfbff)
  391.  
  392. #define spy(atom)                (info(atom) & 0x0200)
  393. #define setspy(atom)             (info(atom) |=0x0200)
  394. #define setnotspy(atom)          (info(atom) &=0xfdff)
  395.  
  396. #define rc(atom)                 (info(atom) & 0x0100)
  397. #define setrc(atom)              (info(atom) |=0x0100)
  398. #define setnotrc(atom)           (info(atom) &=0xfeff)
  399.  
  400. #define ensure(atom)             (info(atom) & 0x1000)
  401. #define setensure(atom)          (info(atom) |=0x1000)
  402. #define setnotensure(atom)       (info(atom) &=0xefff)
  403.  
  404. #define hide(atom)               (info(atom) & 0x2000)
  405. #define sethide(atom)            (info(atom) |=0x2000)
  406. #define setnothide(atom)         (info(atom) &=0xdfff)
  407.  
  408. #define first(atom)              (info(atom) & 0x4000)
  409. #define setfirst(atom)           (info(atom) |=0x4000)
  410. #define setnotfirst(atom)        (info(atom) &=0xbfff)
  411.  
  412.  
  413. /**************************************************************/
  414. /*
  415.  *  trail
  416.  */
  417. /**************************************************************/
  418.  
  419. #if !POINTEROFFSET
  420. farexternal(TERM,TRAILTAB);
  421.  
  422. #define boundvar(v)  faracc(TERM,TRAILTAB,v) 
  423. #endif
  424.  
  425. #if POINTEROFFSET
  426. #ifdef DYNMEM
  427. IMPORT TERM *TRAILTAB;
  428. #else
  429. IMPORT TERM TRAILTAB[];
  430. #endif
  431. #define boundvar(v)    (*(v))
  432. #endif
  433.  
  434. /**************************************************************/
  435. /*
  436.  *  environments
  437.  */
  438. /**************************************************************/
  439.  
  440. #ifdef DYNMEM
  441. extern TERM *e_FCALL;
  442. extern TERM *e_FBASE;
  443. extern ENV *e_FENV;
  444. extern ENV *e_FCHOICE;
  445. extern ATOM *e_FATOM;
  446. extern CLAUSE *e_FCLAUSE;
  447. extern TRAIL *e_FTRAIL;
  448.  
  449. #else
  450. external(TERM,e_FCALL);
  451. external(TERM,e_FBASE);
  452. external(ENV,e_FENV);
  453. external(ENV,e_FCHOICE);
  454. farexternal(ATOM,e_FATOM);
  455. farexternal(CLAUSE,e_FCLAUSE);
  456. farexternal(TRAIL,e_FTRAIL);
  457. #endif
  458.  
  459. #define call(e)        acc(TERM,e_FCALL,e)
  460. #define base(e)        acc(TERM,e_FBASE,e)
  461. #define env(e)         acc(ENV,e_FENV,e)
  462. #define choice(e)      acc(ENV,e_FCHOICE,e)
  463. #define atomtop(e)     faracc(ATOM,e_FATOM,e)
  464. #define rule(e)        faracc(CLAUSE,e_FCLAUSE,e)
  465. #define trail(e)       faracc(TRAIL,e_FTRAIL,e)
  466.  
  467. /**************************************************************/
  468. /*
  469. **  macros
  470. */
  471. /**************************************************************/
  472.  
  473.  
  474. IMPORT ENV E,CHOICEPOINT;
  475. IMPORT TERM BE;  /* base(E) */
  476. #define deref(T)     deref_(T,BE)
  477.  
  478. IMPORT void out_1(),out_2();
  479. #if INLINE
  480. #define deref_(x,b)  { if(name(x)==UNBOUNDT)\
  481.                         { if(x > HEAPTOP) x=mkfreevar();}\
  482.                        else { if(name(x)==SKELT) x=offset(x)+b; \
  483.                               while(name(x)==VART) x=val(x); }}
  484. #endif
  485.  
  486. #if ! INLINE
  487. IMPORT TERM DEREF();
  488. #define deref_(x,b)    x=DEREF(x,b)
  489. #endif
  490.  
  491. #if REALARITH
  492. #define REAL double
  493. #define REALSIZE (sizeof(REAL) / sizeof(int))
  494. IMPORT REAL realval();
  495. IMPORT TERM mkreal();
  496. IMPORT string ftoa();
  497. #endif
  498.  
  499. #if LONGARITH
  500. #define LONG long
  501. #define LONGSIZE (sizeof(LONG) / sizeof(int))
  502. IMPORT LONG longval();
  503. IMPORT TERM mklong();
  504. IMPORT string ltoa();
  505. #endif
  506.  
  507.  
  508. #if REALARITH && LONGARITH
  509. #define is_number(A)    (A==INTT || A==LONGT || A==REALT)
  510. #define is_integer(A)   (A==INTT || A==LONGT)
  511. #endif
  512.  
  513. #if !REALARITH && LONGARITH
  514. #define is_number(A)    (A==INTT || A==LONGT)
  515. #define is_integer(A)   (A==INTT || A==LONGT)
  516. #endif
  517.  
  518. #if REALARITH && !LONGARITH
  519. #define is_number(A)    (A==INTT || A==REALT)
  520. #define is_integer(A)   (A==INTT)
  521. #endif
  522.  
  523. #if !REALARITH && !LONGARITH
  524. #define is_number(A)    (A==INTT)
  525. #define is_integer(A)   (A==INTT)
  526. #endif
  527.  
  528. #define is_heapterm(T)   ( (T) >=HEAPTOP)
  529. IMPORT  TERM HEAPTOP;
  530.  
  531. IMPORT boolean UNIFY();
  532.  
  533. #if INLINE
  534. extern ATOM ATOMHTOP;
  535. #define isheapatom(A)   (A && ((A) <=ATOMHTOP))
  536. #define UNI(X,Y)        UNIFY(1,X,Y,BE,BE,MAXDEPTH)
  537. #endif
  538. #if ! INLINE
  539. IMPORT boolean isheapatom();
  540. IMPORT boolean UNI();
  541. #endif
  542.  
  543. IMPORT void ws( char * ),wi( int ),wc( char ),wq();
  544.  
  545. IMPORT boolean DEBUGFLAG;
  546.  
  547.  
  548.